home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / Perl Mode / perl4.tcl next >
Encoding:
Text File  |  1998-05-29  |  4.6 KB  |  140 lines  |  [TEXT/ALFA]
  1. proc perl4.tcl {} {}
  2.  
  3. if {![info exists perlDocs]} {
  4.     set perlDocs [file join $HOME Help "Perl Commands"]
  5. }
  6.  
  7. ##############################################################################
  8. # Colorization setup
  9. #
  10. # Keywords are separated here according to their location in "Perl Commands",
  11. # for the convenience of the cmd-double-click mechanism.
  12. #
  13. # Expression words are described in the "Compound Statements" section
  14. #
  15. set perlExprWords {  
  16. else elsif for foreach if return unless until while eq ne cmp lt gt le ge
  17. }
  18.  
  19. # Special variables are described in their own section (and are not 
  20. # individually marked, so we have to search for them.)
  21. #
  22. # This group can safely be colorized...
  23. #
  24. set perlNameWords {
  25. @_ $_ $.  $/ $, $" $\\ $\# $% $= $- $~ $^ $| $$ $? $& $` $' $+ $* 
  26. $0 $1 $2 $3 $4 $5 $6 $7 $8 $9 $[ $] $; $! $@ $< $> $( $) $:
  27. }
  28.  
  29. #... while this group is forced lower-case by the current colorization scheme
  30. #
  31. set perlSpecialVars [concat $perlNameWords {
  32. $^D $^F $^I $^P $^T $^W $^X 
  33. $ARGV @ARGV @INC %INC @INC %ENV $SIG $ENV %SIG
  34. }]
  35.  
  36. # Perl operators and functions are indexed via the Marks menu
  37. #
  38. set perlKeyWords {
  39.     accept alarm atan2 Bind binmode caller chdir chmod chop chown chroot 
  40.     close closedir connect continue cos crypt dbmclose dbmopen defined 
  41.     delete die do dump each   eof eval exec exit exp fcntl fileno 
  42.     flock  fork getc getlogin getpeername getpgrp getppid 
  43.     getpriority getgrnam gethostbyname getnetbyname getprotobyname getpwuid 
  44.     getgrgid getservbyname gethostbyaddr getnetbyaddr getprotobynumber 
  45.     getservbyport getpwent getgrent gethostent getnetent getprotoent 
  46.     getservent setpwent setgrent sethostent setnetent setprotoent setservent 
  47.     endpwent endgrent endhostent endnetent endprotoent endservent 
  48.     getsockname getsockopt gmtime goto grep hex  index int ioctl join keys 
  49.     kill last  length link listen local localtime log lstat lstat mkdir 
  50.     msgctl msgget msgsnd msgrcv next oct open opendir ord pack pipe pop 
  51.     print  printf  push q qq qx rand read readdir readlink recv redo
  52.      rename require reset  reverse rewinddir rindex rindex rmdir 
  53.     scalar seek seekdir select semctl semget semop send setpgrp setpriority 
  54.     setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep 
  55.     socket socketpair sort splice split sprintf sqrt srand stat study sub 
  56.     substr symlink syscall sysread system syswrite tell telldir time times 
  57.     tr truncate umask undef  unlink unpack unshift  utime values 
  58.     vec wait waitpid wantarray warn  write 
  59. }
  60. set perlWords [concat $perlKeyWords $perlNameWords $perlExprWords]
  61. regModeKeywords -e {#} -c red -k blue -s [set PerlmodeVars(stringColor)] Perl  $perlWords
  62. unset perlWords
  63.  
  64. ##############################################################################
  65. # Cmd-double-click support for Perl mode. 
  66. # 
  67. proc Perl::DblClick {from to} {
  68.     global HOME perlKeyWords perlSpecialVars perlExprWords
  69.     global perlSearchPath
  70.     
  71.     set pc  [lookAt [expr $from - 1]]
  72.     set ppc [lookAt [expr $from - 2]]
  73.     set tc  [lookAt $to]
  74.     
  75.     # Extend selection to include special characters
  76.     #
  77.     if {$pc == {$}} { 
  78.         if {$from == $to} { incr to }
  79.         incr from -1
  80.         if {$tc == {^}} { incr to }
  81.         
  82.     } elseif {$pc == {^} && $ppc == {$}} {
  83.         incr from -2
  84.         
  85.     } elseif {$pc == {%} || $pc == {@}} {
  86.         incr from -1
  87.     }
  88.     
  89.     # Return if there's no selected text
  90.     if {$to > $from} {
  91.         select $from $to
  92.         set text [getSelect]
  93.         set qtext [quote::Regfind $text]
  94.     } else {
  95.         return
  96.     }
  97.  
  98.     set perlSearchPath {}
  99.     
  100.     # Function call
  101.     if {$pc == "&"} {
  102.          if {![catch {search -f 1 -r 1 -m 0 -s "sub *$qtext *\{" 0} mtch]} {
  103.              pushPosition
  104.              eval select $mtch
  105.              message "Use Ctl-. to return to original position"
  106.          } else {
  107.              message {Sub definition not found}
  108.          }
  109.  
  110.     # Look up keywords in the man page by their file marks
  111.     } elseif {[lsearch -exact $perlKeyWords $text] >= 0} {
  112.         editMark [file join $HOME Help "Perl Commands"] $text
  113.  
  114.     # Special vars aren't marked, so search for their definitions
  115.     } elseif {[lsearch -exact $perlSpecialVars $text] >= 0} {
  116.         if {[lsearch -exact [winNames] "Perl Commands"] >= 0} {
  117.             bringToFront "Perl Commands"
  118.         } else {
  119.             edit [file join $HOME Help "Perl Commands"]
  120.         }
  121.         if {![catch {search -f 0 -r 0 -m 0 -i 0 -s "     $text  " [maxPos]} mtch]} {
  122.             goto [lindex $mtch 0]
  123.         }
  124.  
  125.     # Flow control statements don't have separate entries
  126.     } elseif {[lsearch -exact $perlExprWords $text] >= 0} {
  127.         editMark [file join $HOME Help "Perl Commands"] "Compound statements"
  128.     
  129.     # If user clicked the arg of a 'require' command, open the file
  130.     } elseif {![catch {perlFindRequire $from $to} filename]} {
  131.         openPerlFile $filename
  132.  
  133.     # Other
  134.     } else {
  135.         select $from $to
  136.         message {Command-double-click on keywords, special vars, and req'd filenames}
  137.     }
  138.  
  139. }
  140.